home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / iter8.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  11KB  |  376 lines
  1. /* iter8.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin, 
  26.         reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
  27.          pivrel;
  28. } knstnt_;
  29.  
  30. #define knstnt_1 knstnt_
  31.  
  32. struct {
  33.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  34.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  35. } cirdat_;
  36.  
  37. #define cirdat_1 cirdat_
  38.  
  39. struct {
  40.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  41.         sfactr;
  42.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  43.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  44. } status_;
  45.  
  46. #define status_1 status_
  47.  
  48. struct {
  49.     doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas, 
  50.         rstats[50];
  51.     integer iwidth, lwidth, nopage;
  52. } miscel_;
  53.  
  54. #define miscel_1 miscel_
  55.  
  56. struct {
  57.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  58.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  59. } flags_;
  60.  
  61. #define flags_1 flags_
  62.  
  63. struct {
  64.     doublereal value[200000];
  65. } blank_;
  66.  
  67. #define blank_1 blank_
  68.  
  69. /* Table of constant values */
  70.  
  71. static integer c__1 = 1;
  72.  
  73. /*<       subroutine iter8(itlim) >*/
  74. /* Subroutine */ int iter8_(itlim)
  75. integer *itlim;
  76. {
  77.     /* Format strings */
  78.     static char fmt_301[] = "(\0020warning:  underflow occurred \002,i4,\002\
  79.  time(s)\002)";
  80.  
  81.     /* System generated locals */
  82.     integer i_1;
  83.     doublereal d_1, d_2;
  84.  
  85.     /* Builtin functions */
  86.     integer s_wsfe(), do_fio(), e_wsfe();
  87.  
  88.     /* Local variables */
  89.     extern /* Subroutine */ int load_();
  90.     static doublereal vold, vnew;
  91.     extern /* Subroutine */ int copy8_();
  92.     static integer i, j, k;
  93.     extern /* Subroutine */ int dcsol_();
  94.     static integer ipass, ntemp;
  95.     extern /* Subroutine */ int dcdcmp_();
  96. #define nodplc ((integer *)&blank_1)
  97. #define cvalue ((complex *)&blank_1)
  98.     static integer ndrflo;
  99.     extern /* Subroutine */ int sizmem_();
  100.     static integer nic;
  101.     static doublereal tol;
  102.  
  103.     /* Fortran I/O blocks */
  104.     static cilist io__13 = { 0, 0, 0, fmt_301, 0 };
  105.  
  106.  
  107. /*<       implicit double precision (a-h,o-z) >*/
  108.  
  109. /*     this routine drives the newton-raphson iteration technique used to 
  110. */
  111. /* solve the set of nonlinear circuit equations. */
  112.  
  113. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  114. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  115. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  116. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  117. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  118. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  119. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  120. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  121. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  122. /* spice version 2g.6  sccsid=knstnt 3/15/83 */
  123. /*<       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
  124. /*<      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
  125. /*<      2   pivtol,pivrel >*/
  126. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  127. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  128. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  129. /* spice version 2g.6  sccsid=status 3/15/83 */
  130. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  131. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  132. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  133. /* spice version 2g.6  sccsid=miscel 3/15/83 */
  134. /*<       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
  135. /*<      1  defas,rstats(50),iwidth,lwidth,nopage >*/
  136. /* spice version 2g.6  sccsid=flags 3/15/83 */
  137. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  138. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  139. /* spice version 2g.6  sccsid=blank 3/15/83 */
  140. /*<       common /blank/ value(200000) >*/
  141. /*<       integer nodplc(64) >*/
  142. /*<       complex cvalue(32) >*/
  143. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  144.  
  145.  
  146. /*<       igoof=0 >*/
  147.     flags_1.igoof = 0;
  148. /*<       iterno=0 >*/
  149.     status_1.iterno = 0;
  150. /*<       ndrflo=0 >*/
  151.     ndrflo = 0;
  152. /*<       noncon=0 >*/
  153.     status_1.noncon = 0;
  154. /*<       ipass=0 >*/
  155.     ipass = 0;
  156.  
  157. /*  construct linear equations and check convergence */
  158.  
  159. /*<    10 ivmflg=0 >*/
  160. L10:
  161.     status_1.ivmflg = 0;
  162. /*<       call load >*/
  163.     load_();
  164. /*<    15 if ((mode.eq.1).and.(modedc.eq.2).and.(nosolv.ne.0)) go to 300 >*/
  165. /* L15: */
  166.     if (status_1.mode == 1 && status_1.modedc == 2 && status_1.nosolv != 0) {
  167.     goto L300;
  168.     }
  169. /*<       iterno=iterno+1 >*/
  170.     ++status_1.iterno;
  171. /*<       go to (20,30,40,60,50,60),initf >*/
  172.     switch (status_1.initf) {
  173.     case 1:  goto L20;
  174.     case 2:  goto L30;
  175.     case 3:  goto L40;
  176.     case 4:  goto L60;
  177.     case 5:  goto L50;
  178.     case 6:  goto L60;
  179.     }
  180. /*<    20 if(mode.ne.1) go to 22 >*/
  181. L20:
  182.     if (status_1.mode != 1) {
  183.     goto L22;
  184.     }
  185. /*<       call sizmem(nsnod,nic) >*/
  186.     sizmem_(&tabinf_1.nsnod, &nic);
  187. /*<       if (nic.eq.0) go to 22 >*/
  188.     if (nic == 0) {
  189.     goto L22;
  190.     }
  191. /*<       if (ipass.ne.0) noncon=ipass >*/
  192.     if (ipass != 0) {
  193.     status_1.noncon = ipass;
  194.     }
  195. /*<       ipass=0 >*/
  196.     ipass = 0;
  197. /*<    22 if (noncon.eq.0) go to 300 >*/
  198. L22:
  199.     if (status_1.noncon == 0) {
  200.     goto L300;
  201.     }
  202. /*<       go to 100 >*/
  203.     goto L100;
  204. /*<    30 initf=3 >*/
  205. L30:
  206.     status_1.initf = 3;
  207. /*<       if(lvlcod.eq.3) lvlcod=2 >*/
  208.     if (flags_1.lvlcod == 3) {
  209.     flags_1.lvlcod = 2;
  210.     }
  211. /*<       ipiv=1 >*/
  212.     status_1.ipiv = 1;
  213. /*<    40 if (noncon.eq.0) initf=1 >*/
  214. L40:
  215.     if (status_1.noncon == 0) {
  216.     status_1.initf = 1;
  217.     }
  218. /*<       ipass=1 >*/
  219.     ipass = 1;
  220. /*<       go to 100 >*/
  221.     goto L100;
  222. /*<    50 if (iterno.gt.1) go to 60 >*/
  223. L50:
  224.     if (status_1.iterno > 1) {
  225.     goto L60;
  226.     }
  227. /*<       ipiv=1 >*/
  228.     status_1.ipiv = 1;
  229. /*<       if (lvlcod.eq.3) lvlcod=2 >*/
  230.     if (flags_1.lvlcod == 3) {
  231.     flags_1.lvlcod = 2;
  232.     }
  233. /*<    60 initf=1 >*/
  234. L60:
  235.     status_1.initf = 1;
  236.  
  237. /*  solve equations for next iteration */
  238.  
  239. /*<   100 if (iterno.ge.itlim) go to 200 >*/
  240. L100:
  241.     if (status_1.iterno >= *itlim) {
  242.     goto L200;
  243.     }
  244. /*<   102 call dcdcmp >*/
  245. L102:
  246.     dcdcmp_();
  247. /*<       if (igoof.ne.0) go to 400 >*/
  248.     if (flags_1.igoof != 0) {
  249.     goto L400;
  250.     }
  251. /*<       if (lvlcod.eq.1) go to 105 >*/
  252.     if (flags_1.lvlcod == 1) {
  253.     goto L105;
  254.     }
  255. /*<   105 call dcsol >*/
  256. L105:
  257.     dcsol_();
  258. /*<       go to 120 >*/
  259.     goto L120;
  260. /*<   120 if (igoof.eq.0) go to 130 >*/
  261. L120:
  262.     if (flags_1.igoof == 0) {
  263.     goto L130;
  264.     }
  265. /*<       igoof=0 >*/
  266.     flags_1.igoof = 0;
  267. /*<       if (lvlcod.ne.1) lvlcod=2 >*/
  268.     if (flags_1.lvlcod != 1) {
  269.     flags_1.lvlcod = 2;
  270.     }
  271. /*<       ipiv=1 >*/
  272.     status_1.ipiv = 1;
  273. /*<       call load >*/
  274.     load_();
  275. /*<       go to 102 >*/
  276.     goto L102;
  277. /*<   130 value(lvn+1)=0.0d0 >*/
  278. L130:
  279.     blank_1.value[tabinf_1.lvn] = 0.;
  280. /*<       do 135 i=1,nstop >*/
  281.     i_1 = cirdat_1.nstop;
  282.     for (i = 1; i <= i_1; ++i) {
  283. /*<       j=nodplc(icswpr+i) >*/
  284.     j = nodplc[tabinf_1.icswpr + i - 1];
  285. /*<       k=nodplc(irswpf+j) >*/
  286.     k = nodplc[tabinf_1.irswpf + j - 1];
  287. /*<       value(lvntmp+k)=value(lvnim1+i) >*/
  288.     blank_1.value[tabinf_1.lvntmp + k - 1] = blank_1.value[
  289.         tabinf_1.lvnim1 + i - 1];
  290. /*<   135 continue >*/
  291. /* L135: */
  292.     }
  293. /*<       call copy8(value(lvntmp+1),value(lvnim1+1),nstop) >*/
  294.     copy8_(&blank_1.value[tabinf_1.lvntmp], &blank_1.value[tabinf_1.lvnim1], &
  295.         cirdat_1.nstop);
  296. /*<       ntemp=noncon >*/
  297.     ntemp = status_1.noncon;
  298. /*<       noncon=0 >*/
  299.     status_1.noncon = 0;
  300. /*<       if (ntemp.gt.0) go to 150 >*/
  301.     if (ntemp > 0) {
  302.     goto L150;
  303.     }
  304. /*<       if (iterno.eq.1) go to 150 >*/
  305.     if (status_1.iterno == 1) {
  306.     goto L150;
  307.     }
  308. /*<       do 140 i=2,numnod >*/
  309.     i_1 = cirdat_1.numnod;
  310.     for (i = 2; i <= i_1; ++i) {
  311. /*<       vold=value(lvnim1+i) >*/
  312.     vold = blank_1.value[tabinf_1.lvnim1 + i - 1];
  313. /*<       vnew=value(lvn+i) >*/
  314.     vnew = blank_1.value[tabinf_1.lvn + i - 1];
  315. /*<       tol=reltol*dmax1(dabs(vold),dabs(vnew))+vntol >*/
  316. /* Computing MAX */
  317.     d_1 = abs(vold), d_2 = abs(vnew);
  318.     tol = knstnt_1.reltol * max(d_2,d_1) + knstnt_1.vntol;
  319. /*<       if (dabs(vold-vnew).le.tol) go to 140 >*/
  320.     if ((d_1 = vold - vnew, abs(d_1)) <= tol) {
  321.         goto L140;
  322.     }
  323. /*<       noncon=noncon+1 >*/
  324.     ++status_1.noncon;
  325. /*<   140 continue >*/
  326. L140:
  327.     ;}
  328. /*<   150 do 160 i=1,nstop >*/
  329. L150:
  330.     i_1 = cirdat_1.nstop;
  331.     for (i = 1; i <= i_1; ++i) {
  332. /*<       j=nodplc(icswpr+i) >*/
  333.     j = nodplc[tabinf_1.icswpr + i - 1];
  334. /*<       k=nodplc(irswpf+j) >*/
  335.     k = nodplc[tabinf_1.irswpf + j - 1];
  336. /*<       value(lvnim1+i)=value(lvn+k) >*/
  337.     blank_1.value[tabinf_1.lvnim1 + i - 1] = blank_1.value[tabinf_1.lvn + 
  338.         k - 1];
  339. /*<   160 continue >*/
  340. /* L160: */
  341.     }
  342. /*     write(iofile,151) (value(lvn+k),k=1,nstop) */
  343. /* 151 format(' solution: '/1p12d10.3) */
  344. /*<       go to 10 >*/
  345.     goto L10;
  346.  
  347. /*  no convergence */
  348.  
  349. /*<   200 igoof=1 >*/
  350. L200:
  351.     flags_1.igoof = 1;
  352. /*<   300 if (ndrflo.eq.0) go to 400 >*/
  353. L300:
  354.     if (ndrflo == 0) {
  355.     goto L400;
  356.     }
  357. /*<       write (iofile,301) ndrflo >*/
  358.     io__13.ciunit = status_1.iofile;
  359.     s_wsfe(&io__13);
  360.     do_fio(&c__1, (char *)&ndrflo, (ftnlen)sizeof(integer));
  361.     e_wsfe();
  362. /*<   301 format('0warning:  underflow occurred ',i4,' time(s)') >*/
  363.  
  364. /*  finished */
  365.  
  366. /*<   400 return >*/
  367. L400:
  368.     return 0;
  369. /*<       end >*/
  370. } /* iter8_ */
  371.  
  372. #undef cvalue
  373. #undef nodplc
  374.  
  375.  
  376.